home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / TOOLPAS2 / INTRCOMM.PAS < prev    next >
Pascal/Delphi Source File  |  1991-01-24  |  21KB  |  777 lines
  1.  
  2. (*
  3.  * Copyright 1987, 1989 Samuel H. Smith;  All rights reserved
  4.  *
  5.  * This is a component of the ProDoor System.
  6.  * Do not distribute modified versions without my permission.
  7.  * Do not remove or alter this notice or any other copyright notice.
  8.  * If you use this in your own program you must distribute source code.
  9.  * Do not use any of this in a commercial product.
  10.  *
  11.  *)
  12.  
  13. unit INTRCOMM;
  14.  
  15. interface
  16.  
  17. uses DOS;
  18.  
  19. const
  20.    com1 = 0;
  21.    com2 = 1;
  22.    com3 = 2;
  23.  
  24.    disable_cts_check: boolean = false; {false if RTS handshake is needed}
  25.  
  26.    even_parity:  boolean = false;   (* strip parity? *)
  27.  
  28.    ctrl_K_seen:  boolean = false;   (* set when ^K received *)
  29.  
  30. procedure INTR_init_com(chan: integer);
  31. procedure INTR_set_baud_rate(speed: word);
  32.  
  33. procedure INTR_lower_dtr;
  34. procedure INTR_raise_dtr;
  35.  
  36. procedure INTR_transmit_data(s:    string);
  37. procedure INTR_flush_com;
  38. function  INTR_receive_ready: boolean;
  39. function  INTR_receive_data:  char;
  40.  
  41. procedure INTR_uninit_com;
  42.  
  43.  
  44. (************** private *************)
  45.  
  46. procedure INTR_select_port(chan: integer);
  47. procedure INTR_service_transmit;
  48. procedure INTR_poll_transmit;
  49. procedure INTR_service_receive;
  50. procedure INTR_check_interrupts;
  51.  
  52. procedure control_k;
  53. procedure verify_txque_space;
  54.  
  55. procedure cancel_xoff;
  56. procedure disable_int;  inline($FA);
  57. procedure enable_int;   inline($FB);
  58. procedure io_delay;     inline($EB/$00);     {jmp $+2}
  59.  
  60.  
  61. implementation
  62.  
  63. const
  64.    queue_size       = 3000;   {fixed size of all queues}
  65.    queue_high_water = 2700;   {maximum queue.count before blocking}
  66.    queue_low_water  = 2400;   {unblock queue at this point}
  67.  
  68. type
  69.    queue_rec = record
  70.       next_in:  integer;
  71.       next_out: integer;
  72.       count:    integer;
  73.       data:     array[1..queue_size] of char;
  74.    end;
  75.  
  76. const
  77.    carrier_lost = #$E3;         (* code returned with carrier is lost *)
  78.  
  79.    com_chan:     integer = -1;  (* currently selected com channel; 0..2 *)
  80.                                 (* -1 indicates local/no com port *)
  81.  
  82.    port_base:    integer = -1;  (* base port number for 8250 chip *)
  83.                                 (* value = -1 until init is finished *)
  84.  
  85.    port_irq:     integer = -1;  (* port irq number *)
  86.  
  87.    old_vector:   pointer = nil; (* pointer to original com interrupt handler *)
  88.    
  89.    XOFF_char:    char = ^S;     (* XOFF character code *)
  90.  
  91. var
  92.    port_intr:    integer;       (* interrupt number for 8250 chip *)
  93.    intr_mask:    integer;       (* interrupt controller initialization code *)
  94.  
  95.    prev_LCR:     integer;       (* previous LCR contents *)
  96.    prev_IER:     integer;       (* previous IER contents *)
  97.    prev_MCR:     integer;       (* previous MCR contents *)
  98.    prev_ICTL:    integer;       (* previous ICTL contents *)
  99.  
  100.    xmit_active:  boolean;       (* is the transmitter active now?
  101.                                    (is a THRE interrupt expected?) *)
  102.  
  103.    XOFF_active:  boolean;       (* has XOFF suspended transmit? *)
  104.  
  105.    rxque:        queue_rec;     (* receive data queue *)
  106.    txque:        queue_rec;     (* transmit data queue *)
  107.  
  108.    reg:          registers;     (* register package *)
  109.  
  110.  
  111. (*
  112.  * Uart register definitions
  113.  *
  114.  *)
  115.  
  116. const
  117.    ICTL = $21;                  (* system interrupt controller i/o port *)
  118.  
  119.    RBR = 0;  (* receive buffer register *)
  120.    THR = 0;  (* transmit holding register *)
  121.  
  122.    DLM = 1;  (* divisor latch MSB *)
  123.    IER = 1;  (* interrupt enable register *)
  124.       IER_DAV     = $01;       (* data available interrupt *)
  125.       IER_THRE    = $02;       (* THR empty interrupt *)
  126.       IER_LSRC    = $04;       (* line status change interrupt *)
  127.       IER_MSR     = $08;       (* modem status interrupt *)
  128.  
  129.  
  130.    IIR = 2;  (* interrupt identification register *)
  131.       IIR_PENDING = $01;       (* low when interrupt pending *)
  132.  
  133.       IIR_MASK    = $06;       (* mask for interrupt identification *)
  134.         IIR_MSR     = $00;       (* modem status change interrupt *)
  135.         IIR_THRE    = $02;       (* transmit holding reg empty interrupt *)
  136.         IIR_DAV     = $04;       (* data available interrupt *)
  137.         IIR_LSR     = $06;       (* line status change interrupt *)
  138.  
  139.  
  140.    LCR = 3;  (* line control register *)
  141.       LCR_5BITS   = $00;       (* 5 data bits *)
  142.       LCR_7BITS   = $02;       (* 7 data bits *)
  143.       LCR_8BITS   = $03;       (* 8 data bits *)
  144.  
  145.       LCR_1STOP   = $00;       (* 1 stop bit *)
  146.       LCR_2STOP   = $04;       (* 2 stop bits *)
  147.  
  148.       LCR_NPARITY = $00;       (* no parity *)
  149.       LCR_EPARITY = $38;       (* even parity *)
  150.  
  151.       LCR_NOBREAK = $00;       (* break disabled *)
  152.       LCR_BREAK   = $40;       (* break enabled *)
  153.  
  154.      {LCR_NORMAL  = $00;}      (* normal *)
  155.       LCR_ABDL    = $80;       (* address baud divisor latch *)
  156.  
  157.  
  158.    MCR = 4;  (* modem control register *)
  159.       MCR_DTR     = $01;       (* active DTR *)
  160.       MCR_RTS     = $02;       (* active RTS *)
  161.       MCR_OUT1    = $04;       (* enable OUT1 *)
  162.       MCR_OUT2    = $08;       (* enable OUT2 -- COM INTERRUPT ENABLE *)
  163.       MCR_LOOP    = $10;       (* loopback mode *)
  164.  
  165.  
  166.    LSR = 5;  (* line status register *)
  167.      LSR_DAV      = $01;       (* data available *)
  168.      LSR_OERR     = $02;       (* overrun error *)
  169.      LSR_PERR     = $04;       (* parity error *)
  170.      LSR_FERR     = $08;       (* framing error *)
  171.      LSR_BREAK    = $10;       (* break received *)
  172.      LSR_THRE     = $20;       (* THR empty *)
  173.      LSR_TSRE     = $40;       (* transmit shift register empty *)
  174.  
  175.      LOERR_count:       integer = 0;    {overrun error count}
  176.      LPERR_count:       integer = 0;    {parity error count}
  177.      LFERR_count:       integer = 0;    {framing error count}
  178.      LBREAK_count:      integer = 0;    {break received count}
  179.  
  180.  
  181.    MSR = 6;  (* modem status register *)
  182.      MSR_DCTS     = $01;       (* delta CTS *)
  183.      MSR_DDSR     = $02;       (* delta DSR *)
  184.      MSR_DRING    = $04;       (* delta ring *)
  185.      MSR_DRLSD    = $08;       (* delta receive line signal detect *)
  186.      MSR_CTS      = $10;       (* clear to send *)
  187.      MSR_DSR      = $20;       (* data set ready *)
  188.      MSR_RING     = $40;       (* ring detect *)
  189.      MSR_RLSD     = $80;       (* receive line signal detect *)
  190.  
  191.    {0=com1, 1=com2, 2=com3}
  192.    COM_BASE_TABLE: ARRAY[0..2] OF WORD = ($3F8,$2F8,$3E8);
  193.    COM_IRQ_TABLE:  ARRAY[0..2] OF BYTE = (4, 3, 4);
  194.  
  195.    IRQ_MASK_TABLE: ARRAY[0..7] OF BYTE = ($01,$02,$04,$08,$10,$20,$40,$80);
  196.    IRQ_VECT_TABLE: ARRAY[0..7] OF BYTE = ($08,$09,$0A,$0B,$0C,$0D,$0E,$0F);
  197.  
  198.  
  199. (* ------------------------------------------------------------ *)
  200. procedure debug_print(why,s: string);
  201. var
  202.    i: integer;
  203. const
  204.    pwhy: string = 'none';
  205. begin
  206.    if GetEnv('DEBUG') = '' then exit;
  207.  
  208.    if pwhy <> why then
  209.    begin
  210.       writeln;
  211.       write(why,': ');
  212.       pwhy := why;
  213.    end;
  214.  
  215.    for i := 1 to length(s) do
  216.       case s[i] of
  217.       #0..#31:
  218.          write('^',chr(ord(s[i])+ord('@')));
  219.       else
  220.          write(s[i]);
  221.       end;
  222. end;
  223.  
  224. (* ------------------------------------------------------------ *)
  225. procedure give_up_time;
  226.    (* queue wait loop *)
  227. begin
  228. end;
  229.  
  230.  
  231. (* ------------------------------------------------------------ *)
  232. procedure control_k;
  233.    (* process cancel-output command *)
  234. begin
  235.    txque.next_in := 1;
  236.    txque.next_out := 1;          (* throw away pending output *)
  237.    txque.count := 0;             
  238.    ctrl_K_seen := true;
  239. end;
  240.  
  241.  
  242. (* ------------------------------------------------------------ *)
  243. procedure INTR_service_MSR;
  244.   (* modem status change interrupt *)
  245. var
  246.    c: byte;
  247. begin
  248.    c := port[ port_base+MSR ];
  249.    io_delay;
  250. end;
  251.  
  252.  
  253. (* ------------------------------------------------------------ *)
  254. procedure INTR_service_LSR;
  255.    (* line status change interrupt *)
  256. var
  257.    c: byte;
  258. begin
  259.    c := port[ port_base+LSR ];
  260.    io_delay;
  261. end;
  262.  
  263.  
  264. (* ------------------------------------------------------------ *)
  265. procedure INTR_service_transmit;
  266.    (* low-level interrupt service for transmit, call only when transmit
  267.       holding register is empty *)
  268. var
  269.    c:       char;
  270. const
  271.    recur:  boolean = false;
  272.  
  273. begin
  274.  
  275. (* prevent recursion fb/bg *)
  276.    if recur then exit;
  277.    recur := true;
  278.  
  279. (* drop out if transmitter is busy *)
  280.    if (port[ port_base+LSR ] and LSR_THRE) = 0 then
  281.    begin
  282.       io_delay;
  283.       recur := false;
  284.       exit;
  285.    end;
  286.  
  287.    io_delay;
  288.  
  289.    (* stop transmitting when queue is empty, or XOFF is active
  290.       or it is not CLEAR-to-send to modem *)
  291.  
  292.    xmit_active := (txque.count <> 0) and (not xoff_active) and
  293.                   (disable_CTS_check or ((port[port_base+MSR] and MSR_CTS)>0));
  294.  
  295.    io_delay;
  296.  
  297.    (* start next byte transmitting *)
  298.    if xmit_active then
  299.    begin
  300.       c := txque.data[txque.next_out];
  301.       if txque.next_out < sizeof(txque.data) then
  302.          inc(txque.next_out)
  303.       else
  304.          txque.next_out := 1;
  305.       dec(txque.count);
  306.  
  307.       port[ port_base+THR ] := ord(c); io_delay;
  308.    end;
  309.  
  310.    recur := false;
  311. end;
  312.  
  313.  
  314. (* ------------------------------------------------------------ *)
  315. procedure INTR_service_receive;
  316.    (* low-level interrupt service for receive data,
  317.       call only when receive data is ready *)
  318. var
  319.    c: char;
  320.    o: byte;
  321.  
  322. begin
  323.    o := port[ port_base+LSR ];
  324.    io_delay;
  325.  
  326. (***
  327.    if (o and LSR_OERR) <> 0 then inc(LOERR_count);
  328.    if (o and LSR_PERR) <> 0 then inc(LPERR_count);
  329.    if (o and LSR_FERR) <> 0 then inc(LFERR_count);
  330.    if (o and LSR_BREAK)<> 0 then inc(LBREAK_count);
  331. ***)
  332.  
  333.    if (o and LSR_DAV) = 0 then
  334.       exit;
  335.  
  336.    c := chr( port[ port_base+RBR ] ); io_delay;
  337.  
  338.    if XOFF_active then           (* XOFF cancelled by any character *)
  339.       cancel_xoff
  340.    else
  341.  
  342.    if c = XOFF_char then         (* process XOFF/XON flow control *)
  343.       XOFF_active := true
  344.    else
  345.  
  346.    if (c = ^K) then              (* process cancel-output command *)
  347.       control_k
  348.    else
  349.  
  350.    if c = carrier_lost then      (* ignore this special character! *)
  351.    begin
  352.       {do nothing}
  353.    end
  354.    else
  355.  
  356.    if rxque.count < sizeof(rxque.data) then
  357.    begin
  358.       inc(rxque.count);
  359.       rxque.data[rxque.next_in] := c;
  360.       if rxque.next_in < sizeof(rxque.data) then
  361.          inc(rxque.next_in)
  362.       else
  363.          rxque.next_in := 1;
  364.    end;
  365. end;
  366.  
  367.  
  368. (* ------------------------------------------------------------ *)
  369. procedure INTR_poll_transmit;
  370.    (* recover from CTS or XOF handshake when needed *)
  371. begin
  372.    {no action if nothing to transmit}
  373.    if (txque.count = 0) or (com_chan < 0){local} then
  374.       exit;
  375.  
  376.    {check for XON if output suspended by XOFF}
  377.    INTR_service_receive;
  378.    INTR_service_transmit;
  379. end;
  380.  
  381.  
  382. (* ------------------------------------------------------------ *)
  383. procedure cancel_xoff;
  384. begin
  385.    XOFF_active := false;
  386.    INTR_poll_transmit;
  387. end;
  388.  
  389.  
  390. (* ------------------------------------------------------------ *)
  391. procedure INTR_check_interrupts;
  392.    (* check for and process any pending 8250 interrupts.
  393.       can be called from TPAS *)
  394. var
  395.    status:  integer;
  396.  
  397. begin
  398.  
  399. (* get the interrupt identification register *)
  400.    status := port[ port_base+IIR ]; io_delay;
  401.  
  402. (* repeatedly service interrupts until no more services possible *)
  403.    while (status and IIR_PENDING) = 0 do
  404.    begin
  405.       disable_int;
  406.  
  407.       case (status and IIR_MASK) of
  408.          IIR_MSR:   (* modem status change interrupt *)
  409.             INTR_service_MSR;
  410.  
  411.          IIR_THRE:  (* transmit holding register empty interrupt *)
  412.             INTR_service_transmit;
  413.  
  414.          IIR_DAV:   (* data available interrupt *)
  415.             INTR_service_receive;
  416.  
  417.          IIR_LSR:   (* line status change interrupt *)
  418.             INTR_service_MSR;
  419.       end;
  420.  
  421.       enable_int;
  422.  
  423.   (* get the interrupt identification register again *)
  424.       status := port[ port_base+IIR ];
  425.       io_delay;
  426.    end;
  427.  
  428. end;
  429.  
  430.  
  431. (* ------------------------------------------------------------ *)
  432. procedure INTR_interrupt_handler(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP: word);
  433. interrupt;
  434.    (* low-level interrupt service routine.  this procedure processes
  435.       all receive-ready and transmit-ready interrupts from the 8250 chip.
  436.       DO NOT call this proc from TPAS *)
  437.  
  438. begin
  439.  
  440. (* service interrupts until no more services possible *)
  441.    INTR_check_interrupts;
  442.  
  443. (* acknowledge the interrupt and return to foreground operation *)
  444.    port[ $20 ] := $20;   {non-specific EOI} io_delay;
  445.  
  446. end;
  447.  
  448.  
  449. (* ------------------------------------------------------------ *)
  450. function INTR_receive_ready: boolean;
  451.    (* see if any receive data is ready on the active com port *)
  452. begin
  453.    INTR_poll_transmit;
  454.    INTR_receive_ready := rxque.count > 0;
  455. end;
  456.  
  457.  
  458. (* ------------------------------------------------------------ *)
  459. procedure INTR_flush_com;
  460.    (* wait for all pending transmit data to be sent *)
  461. begin
  462.    enable_int;
  463.    while txque.count > 0 do
  464.    begin
  465.       INTR_poll_transmit;
  466.       give_up_time;             (* give up extra time *)
  467.    end;
  468. end;
  469.  
  470.  
  471. (* ------------------------------------------------------------ *)
  472. procedure verify_txque_space;
  473.    (* wait until there is enough space in the queue for this message *)
  474.    (* or until flow control is released *)
  475. begin
  476.    while txque.count > queue_low_water do
  477.    begin
  478.       INTR_poll_transmit;
  479.       give_up_time;             (* give up extra time *)
  480.    end;
  481. end;
  482.  
  483.  
  484. (* ------------------------------------------------------------ *)
  485. procedure INTR_lower_dtr;
  486.    (* lower DTR to inhibit modem answering *)
  487. var
  488.    o: byte;
  489. begin
  490.    if (com_chan < 0) then exit;
  491.  
  492.    o := port [ port_base+MCR ];                 io_delay;
  493.    port[ port_base+MCR ] := o and not MCR_DTR;  io_delay;
  494. end;
  495.  
  496.  
  497. (* ------------------------------------------------------------ *)
  498. procedure INTR_raise_dtr;
  499.    (* raise DTR to allow modem answering - not supported by BIOS *)
  500. var
  501.    o: byte;
  502. begin
  503.    if (com_chan < 0) then exit;
  504.  
  505.    o := port [ port_base+MCR ];                       io_delay;
  506.    port[ port_base+MCR ] := o or (MCR_DTR+MCR_RTS);   io_delay;
  507. end;
  508.  
  509.  
  510. (* ------------------------------------------------------------ *)
  511. procedure INTR_select_port(chan: integer);
  512.    (* lookup the port address for the specified com channel *)
  513. begin
  514.    com_chan := chan;
  515.    xmit_active := false;
  516.    XOFF_active := false;
  517.  
  518.    if (chan >= 0) and (chan <= 2) then
  519.    begin
  520.       port_base := COM_BASE_TABLE[chan];
  521.       port_irq := COM_IRQ_TABLE[chan];
  522.       port_intr := IRQ_VECT_TABLE[port_irq];
  523.       intr_mask := IRQ_MASK_TABLE[port_irq];
  524.    end;
  525.  
  526. (**
  527. writeln('[chan=',chan,' port base=',port_base,' intr=',port_intr,' mask=',intr_mask,']');
  528. **)
  529.  
  530. (* initialize the receive and transmit queues *)
  531.    rxque.next_in := 1;
  532.    rxque.next_out := 1;
  533.    rxque.count := 0;
  534.  
  535.    txque.next_in := 1;
  536.    txque.next_out := 1;
  537.    txque.count := 0;
  538.  
  539.    INTR_raise_dtr;
  540. end;
  541.  
  542.  
  543. (* ------------------------------------------------------------ *)
  544. procedure INTR_init_com(chan: integer);
  545.    (* initialize communication handlers for operation with the specified
  546.       com port number.  must be called before any other services here *)
  547. var
  548.    o: byte;
  549. begin
  550.  
  551. (* initialize port numbers, receive and transmit queues *)
  552.    INTR_select_port(chan);
  553.  
  554.    if chan < 0 then exit;
  555.  
  556. (* save the old interrupt handler's vector *)
  557.    GetIntVec(port_intr, old_vector);
  558. {writeln('got old');}
  559.  
  560. (* install a vector to the new handler *)
  561.    SetIntVec(port_intr,@INTR_interrupt_handler);
  562. {writeln('new set');}
  563.  
  564. (* save original 8250 registers *)
  565.    disable_int;
  566.    prev_LCR := port[ port_base+LCR ];              io_delay;
  567.    prev_MCR := port[ port_base+MCR ];              io_delay;
  568.    prev_IER := port[ port_base+IER ];              io_delay;
  569.    prev_ICTL  := port[ ICTL ];                     io_delay;
  570.  
  571. (* clear divisor latch if needed *)
  572.    port[ port_base+LCR ] := prev_LCR and not LCR_ABDL;
  573.    io_delay;
  574.  
  575. (* initialize the 8250 for interrupts *)
  576.    o := port[ port_base+MCR ];                     io_delay;
  577.    port[ port_base+MCR ] := o or MCR_OUT2;         io_delay;
  578.    port[ port_base+IER ] := IER_DAV+IER_THRE;      io_delay;
  579.  
  580. (* enable the interrupt through the interrupt controller *)
  581.    o := port[ ICTL ];                              io_delay;
  582.    port[ ICTL ] := o and (not intr_mask);          io_delay;
  583.    enable_int;
  584.  
  585. (* initialize the receive queues in case of an initial garbage byte *)
  586.    disable_int;
  587.    rxque.next_in := 1;
  588.    rxque.next_out := 1;
  589.    rxque.count := 0;
  590.    enable_int;
  591.  
  592. {writeln('init done');}
  593.  
  594. end;
  595.  
  596.  
  597. (* ------------------------------------------------------------ *)
  598. procedure INTR_uninit_com;
  599.    (* remove interrupt handlers for the com port
  600.       must be called before exit to system *)
  601. var
  602.    o: byte;
  603. begin
  604.    if (port_base = -1) or (old_vector = nil) then
  605.       exit;
  606.  
  607. (* wait for the pending data to flush from the queue *)
  608.    INTR_flush_com;
  609.  
  610. (* attach the old handler to the interrupt vector *)
  611.    disable_int;
  612.  
  613.    SetIntVec(port_intr, old_vector);
  614.  
  615.    port[ port_base+LCR ] := prev_LCR;     io_delay;
  616.    port[ port_base+MCR ] := prev_MCR;     io_delay;
  617.    port[ port_base+IER ] := prev_IER;     io_delay;
  618.    o := port[ ICTL ];                     io_delay;
  619.    port[ ICTL ] := (o and not intr_mask) or (prev_ICTL and intr_mask);
  620.    io_delay;
  621.  
  622.    enable_int;
  623.  
  624. (***
  625. writeln('prev: LCR=',itoh(prev_LCR),
  626.              ' MCR=',itoh(prev_MCR),
  627.              ' IER=',itoh(prev_IER),
  628.              ' ICTL=',itoh(prev_ICTL));
  629. ****)
  630. (***
  631. writeln(' now: LCR=',itoh(port[ port_base+LCR ]),
  632.              ' MCR=',itoh(port[ port_base+MCR ]),
  633.              ' IER=',itoh(port[ port_base+IER ]),
  634.              ' ICTL=',itoh(port[ ICTL ]));
  635. ****)
  636. (***
  637. writeln('intr_mask=',itoh(intr_mask),
  638.              ' vector=',itoh(seg(old_vector)),':',itoh(ofs(old_vector)));
  639. ***)
  640.  
  641.    old_vector := nil;
  642. end;
  643.  
  644.  
  645. (* ------------------------------------------------------------ *)
  646. procedure INTR_set_baud_rate(speed: word);
  647. var
  648.    divisor: word;
  649.    o: byte;
  650. begin
  651.    if com_chan < 0 then exit;
  652.    INTR_flush_com;
  653.  
  654.    divisor := 115200 div speed;
  655.    disable_int;
  656.  
  657. (* enable address divisor latch *)
  658.    o := port[port_base+LCR];              io_delay;
  659.    port [port_base+LCR] := o or LCR_ABDL; io_delay;
  660.  
  661. (* set the divisor *)
  662.    portw[port_base+THR] := divisor;       io_delay;
  663.  
  664. (* set 8 bits, 1 stop, no parity, no break, disable divisor latch *)
  665.    prev_LCR := LCR_8BITS   or LCR_1STOP   or
  666.                LCR_NPARITY or LCR_NOBREAK;
  667.  
  668.    port[ port_base+LCR ] := prev_LCR;     io_delay;
  669.  
  670.    enable_int;
  671.  
  672. (****
  673. if debugging then
  674. writeln(debugfd^,'set baud: LCR=',itoh(port[ port_base+LCR ]),
  675.              ' MCR=',itoh(port[ port_base+MCR ]),
  676.              ' IER=',itoh(port[ port_base+IER ]),
  677.              ' ICTL=',itoh(port[ ICTL ]),
  678.              ' div=',divisor,
  679.              ' spd=',speed);
  680. ****)
  681. end;
  682.  
  683.  
  684. (* ------------------------------------------------------------ *)
  685. function INTR_receive_data:  char;
  686.    (* wait for and return 1 character from the active com port *)
  687.    (* returns carrier_lost if carrier is not present *)
  688. var
  689.    c: char;
  690.  
  691. begin
  692.    if com_chan < 0 then exit;
  693.  
  694.    repeat
  695.       io_delay;
  696.  
  697.       if INTR_receive_ready then
  698.       begin
  699.          disable_int;
  700.  
  701.          {deque from rxque}
  702.          c := rxque.data[rxque.next_out];
  703.          if rxque.next_out < sizeof(rxque.data) then
  704.             inc(rxque.next_out)
  705.          else
  706.             rxque.next_out := 1;
  707.          dec(rxque.count);
  708.  
  709.          enable_int;
  710.  
  711.          {strip parity in 7,E mode}
  712.          if even_parity then
  713.             c := chr( ord(c) and $7f );
  714.  
  715.          debug_print('recv',c);
  716.  
  717.          INTR_receive_data := c;
  718.          exit;
  719.       end;
  720.  
  721.       {give up time while waiting}
  722.       give_up_time;
  723.  
  724.       io_delay;
  725.    until not ((port[port_base+MSR] and MSR_RLSD)<>0);
  726.  
  727.    {carrier not present}
  728.    cancel_xoff;
  729.    INTR_receive_data := carrier_lost;
  730. end;
  731.  
  732.  
  733. (* ------------------------------------------------------------ *)
  734. procedure INTR_transmit_data(s:    string);
  735.    (* transmits a string of characters to the specified com port;
  736.       does not transmit when carrier is not present *)
  737. var
  738.    i:    integer;
  739.  
  740. begin
  741.    debug_print('xmit',s);
  742.  
  743.    if com_chan < 0 then exit;
  744.  
  745. (* wait until there is enough space in the queue for this message *)
  746. (* or until flow control is released *)
  747.  
  748.    if txque.count > queue_high_water then
  749.       verify_txque_space;
  750.  
  751.  
  752. (* enque the string to be transmitted *)
  753.    for i := 1 to length(s) do
  754.    begin
  755.       disable_int;
  756.  
  757.       inc(txque.count);
  758.       txque.data[txque.next_in] := s[i];
  759.       if txque.next_in < sizeof(txque.data) then
  760.          inc(txque.next_in)
  761.       else
  762.          txque.next_in := 1;
  763.  
  764.       enable_int;
  765.    end;
  766.  
  767.  
  768. (* force an initial interrupt to get things rolling (in case there are
  769.    no more pending transmit-ready interrupts *)
  770.  
  771.    INTR_poll_transmit;
  772. end;
  773.  
  774.  
  775. end.
  776.  
  777.